home *** CD-ROM | disk | FTP | other *** search
/ DarkBASIC - The Ultimate 3D Game Creator / PCactive 8 CD1 - DarkBasic.iso / SOFTWARE / DEMOS / DarkForge2000 / pcxshow / pcxshow.dba next >
Encoding:
Text File  |  2000-06-23  |  5.7 KB  |  301 lines
  1. ` -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
  2. `             PCX Show v1.0
  3. ` -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
  4. ` By Rich Davey (rich@fatal-design.com)
  5. ` -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
  6. ` Music listened  to while  coding this
  7. ` Gladiator Motion Picture Soundtrack
  8. ` -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
  9. ` Note:
  10. ` Fed-up using BMP's? Well now you can
  11. ` use PCX files instead! You can only
  12. ` use 256 colour PCX files though, but
  13. ` the compression ratio is still far
  14. ` greater than BMP. This is a function
  15. ` for inclusion in your own programs.
  16. `
  17. ` Simply call it with:
  18. `
  19. ` PCXShow("filename.pcx","command",bitmap)
  20. `
  21. ` Where filename.pcx is a valid 256 colour
  22. ` PCX file (of any dimension)
  23. ` Command can be either "info" or "show"
  24. ` info will print a PCX info screen and
  25. ` show will actually render the image
  26. ` Bitmap can be used to tell it to render
  27. ` the pcx to a different bitmap (default is 0)
  28.  
  29. sync rate 0
  30. sync on
  31. hide mouse
  32.  
  33. PCXShow("rich.pcx","info",0)
  34.  
  35. wait key
  36. cls 0
  37.  
  38. PCXShow("rich.pcx","show",0)
  39.  
  40. wait key
  41. end
  42.  
  43.  
  44.  
  45. `    PCX Show Version 1.0 Function
  46. `    (C)opyright Richard Davey, DarkForge, 2000
  47.  
  48. function PCXShow(file$,command$,bmap)
  49.  
  50.     filesize=file size(file$)
  51.     
  52.     if filesize<0
  53.         print "PCXShow Error: File size is zero bytes! Does it exist?"
  54.         wait key
  55.         end
  56.     endif
  57.     
  58.     dim pcx(filesize)
  59.     open to read 1,file$
  60.     
  61.     for a=0 to filesize
  62.         read byte 1,pcx(a)
  63.     next a
  64.     
  65.     close file 1
  66.  
  67.     manufacturer=pcx(0)
  68.     version=pcx(1)
  69.     encoding=pcx(2)
  70.     bitsperpixel=pcx(3)
  71.     planes=pcx(65)
  72.     
  73.     open to read 1,file$
  74.     for a=0 to 3
  75.         read byte 1,null
  76.     next a
  77.     
  78.     read word 1,xmin
  79.     read word 1,ymin
  80.     read word 1,xmax
  81.     read word 1,ymax
  82.     read word 1,hres
  83.     read word 1,vres
  84.     
  85.     for a=0 to 49
  86.         read byte 1,null
  87.     next a
  88.     
  89.     read word 1,bytesperline
  90.     read word 1,paletteinfo
  91.     
  92.     close file 1
  93.     
  94.     dimensionx=xmax-xmin
  95.     dimensiony=ymax-ymin
  96.     inc dimensionx
  97.     inc dimensiony
  98.     
  99.     totalbytes=planes*bytesperline
  100.     
  101.     if manufacturer=10
  102.         manufacturer$="ZSoft"
  103.     else
  104.         manufacturer$="Unknown"
  105.     endif
  106.     
  107.     if version=0 then version$="2.5"
  108.     if version=2 then version$="2.8 w/palette information"
  109.     if version=3 then version$="2.8 w/o palette information"
  110.     if version=5 then version$="3.0"
  111.     if version$="" then version$="Unknown"
  112.     
  113.     if encoding=1
  114.         encoding$="Run Length Encoding"
  115.     else
  116.         encoding$="Unknown"
  117.     endif
  118.     
  119.     if paletteinfo=1 then paletteinfo$="Color/BW"
  120.     if paletteinfo=2 then paletteinfo$="Greyscale"
  121.  
  122.     if pcx(filesize-769)=12
  123.     
  124.         dim vga_r(256)
  125.         dim vga_g(256)
  126.         dim vga_b(256)
  127.     
  128.         vc=0 : a=filesize-768
  129.     
  130.         repeat
  131.             vga_r(vc)=pcx(a)
  132.             vga_g(vc)=pcx(a+1)
  133.             vga_b(vc)=pcx(a+2)
  134.             inc vc
  135.             inc a,3
  136.         until vc=255
  137.     
  138.     else
  139.     
  140.         print "PCXShow Error : No support for < 256 colour PCXs"
  141.         wait key
  142.         end
  143.     
  144.     endif
  145.  
  146.     if command$="info"
  147.  
  148.         for bgcol=50 to 150 step 5
  149.             ink rgb(0,0,bgcol),rgb(0,0,0)
  150.             line 0,by,639,by
  151.             inc by
  152.         next bgcol
  153.  
  154.         for bgcol=150 to 50 step -5
  155.             ink rgb(0,0,bgcol),rgb(0,0,0)
  156.             line 0,by,639,by
  157.             inc by
  158.         next bgcol
  159.  
  160.         by=420
  161.         for bgcol=50 to 150 step 5
  162.             ink rgb(0,0,bgcol),rgb(0,0,0)
  163.             line 0,by,639,by
  164.             inc by
  165.         next bgcol
  166.  
  167.         for bgcol=150 to 50 step -5
  168.             ink rgb(0,0,bgcol),rgb(0,0,0)
  169.             line 0,by,639,by
  170.             inc by
  171.         next bgcol
  172.  
  173.         ink rgb(255,255,255),rgb(0,0,0)
  174.         set text font "Courier"
  175.         set text size 10
  176.         center text 320,15,"PCX Show v1.0 - (C) DarkForge 2000"
  177.         center text 320,435,"www.darkforge.co.uk"
  178.  
  179.         text 50,50,"Filename:"
  180.         text 300,50,file$
  181.  
  182.         text 50,70,"Manufacturer:"
  183.         text 300,70,manufacturer$
  184.  
  185.         text 50,90,"Version:"
  186.         text 300,90,version$
  187.  
  188.         text 50,110,"Encoding:"
  189.         text 300,110,encoding$
  190.  
  191.         text 50,130,"Bits per Pixel:"
  192.         text 300,130,str$(bitsperpixel)
  193.  
  194.         text 50,150,"X Min:"
  195.         text 300,150,str$(xmin)
  196.  
  197.         text 50,170,"Y Min:"
  198.         text 300,170,str$(ymin)
  199.  
  200.         text 50,190,"X Max:"
  201.         text 300,190,str$(xmax)
  202.  
  203.         text 50,210,"Y Max:"
  204.         text 300,210,str$(ymax)
  205.  
  206.         text 50,230,"Colour planes:"
  207.         text 300,230,str$(planes)
  208.  
  209.         text 50,250,"Bytes per Scanline:"
  210.         text 300,250,str$(bytesperline)
  211.  
  212.         text 50,270,"Palette Info:"
  213.         text 300,270,paletteinfo$
  214.  
  215.         center text 320,300,"16 Colour Palette"
  216.  
  217.         ink rgb(255,255,255),rgb(0,0,0)
  218.         blx=320-65
  219.         box blx,320,blx+130,330
  220.  
  221.         i=blx+1
  222.         for a=16 to 47 step 3
  223.             ink rgb(pcx(a),pcx(a+1),pcx(a+2)),rgb(0,0,0)
  224.             box i,321,i+6,329
  225.             inc i,8
  226.         next a
  227.  
  228.         ink rgb(255,255,255),rgb(0,0,0)
  229.         blx=320-255
  230.         box blx,370,blx+513,380
  231.         center text 320,350,"256 Colour Palette"
  232.  
  233.         i=blx+1
  234.         for a=0 to 255
  235.             ink rgb(vga_r(a),vga_g(a),vga_b(a)),rgb(0,0,0)
  236.             box i,371,i+1,379
  237.             inc i,2
  238.         next a
  239.  
  240.     else
  241.  
  242.         x=0 : y=0 : c=128
  243.  
  244.         if bmap>0 then create bitmap bmap,dimensionx,dimensiony
  245.  
  246.         repeat
  247.         
  248.             repeat
  249.             
  250.                 istream=pcx(c)
  251.                 dstream$=bin$(istream)
  252.                 dstream$=right$(dstream$,8)
  253.         
  254.                 if val(left$(dstream$,1))=1 and val(mid$(dstream$,2))=1
  255.                     rlecount=0
  256.                     r=val(mid$(dstream$,3))
  257.                     if r=1 then inc rlecount,32
  258.                     r=val(mid$(dstream$,4))
  259.                     if r=1 then inc rlecount,16
  260.                     r=val(mid$(dstream$,5))
  261.                     if r=1 then inc rlecount,8
  262.                     r=val(mid$(dstream$,6))
  263.                     if r=1 then inc rlecount,4
  264.                     r=val(mid$(dstream$,7))
  265.                     if r=1 then inc rlecount,2
  266.                     r=val(mid$(dstream$,8))
  267.                     if r=1 then inc rlecount
  268.         
  269.                     color=pcx(c+1)
  270.                     ink rgb(vga_r(color),vga_g(color),vga_b(color)),rgb(0,0,0)
  271.             
  272.                     line x,y,x+rlecount,y
  273.                     inc x,rlecount
  274.                     inc c,2
  275.         
  276.                 else
  277.         
  278.                     color=pcx(c)
  279.                     ink rgb(vga_r(color),vga_g(color),vga_b(color)),rgb(0,0,0)
  280.                         if x<dimensionx
  281.                             dot x,y
  282.                             inc x
  283.                         endif
  284.                     inc c
  285.         
  286.                 endif
  287.         
  288.             until x>=dimensionx
  289.         
  290.             x=0
  291.             inc y
  292.         
  293.         until y>=dimensiony
  294.  
  295.         set current bitmap 0
  296.  
  297.     endif
  298.  
  299. endfunction
  300.  
  301.